home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / DELPHI32 / COMPNENT / SAWIN95 / CHKSTRED.PAS < prev    next >
Pascal/Delphi Source File  |  1996-10-11  |  14KB  |  493 lines
  1. unit ChkStrEd;
  2.  
  3. interface
  4.  
  5. uses
  6.   {$IFDEF WIN32}
  7.   Windows,
  8.   {$ELSE}
  9.   WinTypes, WinProcs,
  10.   {$ENDIF}
  11.   SysUtils, Messages, Classes, Graphics, Controls,
  12.   Forms, StdCtrls, Buttons, IniFiles, DsgnIntf, Menus, Grids, Dialogs,
  13.   ExtCtrls;
  14.  
  15. type
  16.   TCheckStringListProperty = class( TPropertyEditor )
  17.     function GetAttributes : TPropertyAttributes; override;
  18.     function GetValue: string; override;
  19.     procedure Edit; override;
  20.   end;
  21.  
  22.   TChkStrLstDlg = class( TForm )
  23.     PnlToolbar: TPanel;
  24.     BtnCut: TSpeedButton;
  25.     BtnCopy: TSpeedButton;
  26.     BtnPaste: TSpeedButton;
  27.     BtnUndo: TSpeedButton;
  28.     BtnFont: TSpeedButton;
  29.     PnlStringList: TPanel;
  30.     LblCount: TLabel;
  31.     Label1: TLabel;
  32.     LblLine: TLabel;
  33.     MnuEdit: TPopupMenu;
  34.     MnuUndo: TMenuItem;
  35.     MnuCut: TMenuItem;
  36.     MnuCopy: TMenuItem;
  37.     MnuPaste: TMenuItem;
  38.     DlgFont: TFontDialog;
  39.     BtnOk: TButton;
  40.     BtnCancel: TButton;
  41.     CHKDefault: TCheckBox;
  42.     grdEdit: TStringGrid;
  43.     cmdDelete: TSpeedButton;
  44.     cmdDown: TSpeedButton;
  45.     cmdUp: TSpeedButton;
  46.     EdtStrings: TMemo;
  47.     procedure FormCreate( Sender : TObject );
  48.     procedure FormDestroy( Sender : TObject );
  49.     procedure BtnOkClick( Sender : TObject );
  50.     procedure BtnFontClick( Sender : TObject );
  51.     procedure BtnUndoClick( Sender : TObject );
  52.     procedure BtnCutClick( Sender : TObject );
  53.     procedure BtnCopyClick( Sender : TObject );
  54.     procedure BtnPasteClick( Sender : TObject );
  55.     procedure grdEditClick(Sender: TObject);
  56.     procedure grdEditDrawCell(Sender: TObject; Col, Row: Longint;
  57.       Rect: TRect; State: TGridDrawState);
  58.     procedure grdEditDblClick(Sender: TObject);
  59.     procedure grdEditKeyPress(Sender: TObject; var Key: Char);
  60.     procedure grdEditMouseDown(Sender: TObject; Button: TMouseButton;
  61.       Shift: TShiftState; X, Y: Integer);
  62.     procedure grdEditMouseMove(Sender: TObject; Shift: TShiftState; X,
  63.       Y: Integer);
  64.     procedure cmdDeleteClick(Sender: TObject);
  65.     procedure cmdDownClick(Sender: TObject);
  66.     procedure cmdUpClick(Sender: TObject);
  67.     procedure grdEditKeyDown(Sender: TObject; var Key: Word;
  68.       Shift: TShiftState);
  69.   private
  70.     DelphiIni : TIniFile;
  71.     FPropName : string;
  72.     procedure UpdateLineColStatus;
  73.     procedure UpdateClipboardStatus;
  74.     procedure EnableButtons( Enable : Boolean );
  75.     procedure ResizeGrid;
  76.   public
  77.     procedure SetTextToGrid;
  78.     procedure SetGridToText;
  79.   end;
  80.  
  81.  
  82. implementation
  83.  
  84. {$R *.DFM}
  85.  
  86. uses
  87.   ClipBrd, Printers, ChkList;
  88.  
  89. const
  90.   Section = 'Nedap.ChkStrListEditor';
  91.  
  92.   fsBoldMask      = 8;
  93.   fsItalicMask    = 4;
  94.   fsUnderlineMask = 2;
  95.   fsStrikeOutMask = 1;
  96.   fsNormal        = 0;
  97.  
  98.  
  99. { TCheckStringListProperty Methods }
  100.  
  101. function TCheckStringListProperty.GetAttributes: TPropertyAttributes;
  102. begin
  103.   Result := [ paReadOnly, paDialog ];                  { Edit method will display a dialog }
  104. end;
  105.  
  106. function TCheckStringListProperty.GetValue : string;
  107. begin
  108.   { The GetPropType method is used to retrieve information pertaining to the   }
  109.   { property type being edited.  In this case, the Name of the property class  }
  110.   { is displayed in the value column of the Object Inspector.                  }
  111.  
  112.   Result := Format( '(%s)', [ GetPropType^.Name ] );
  113. end;
  114.  
  115. procedure TCheckStringListProperty.Edit;
  116. var
  117.   Dialog : TChkStrLstDlg;
  118.   Cls    : TCheckListStrings;
  119.   i      : Integer;
  120.  
  121. begin
  122.   Dialog := TChkStrLstDlg.Create( Application );
  123.   try
  124.     if PropCount = 1 then
  125.     begin
  126.       Dialog.FPropName := GetComponent(0).Owner.Name + '.' +
  127.                           GetComponent(0).Name + '.' + GetName;
  128.       Dialog.Caption :=  Dialog.FPropName + ' - ' + Dialog.Caption;
  129.     end;
  130.  
  131.     { Copy string list of property into the memo of the dialog }
  132.     Cls := TCheckListStrings(GetOrdValue);
  133.     for i:=0 to Cls.Count-1 do
  134.      case Cls.State[i] of
  135.       csUnchecked: Dialog.EdtStrings.Lines.Add('0|'+Cls.Strings[i]);
  136.       csChecked  : Dialog.EdtStrings.Lines.Add('1|'+Cls.Strings[i]);
  137.       csGrayed   : Dialog.EdtStrings.Lines.Add('2|'+Cls.Strings[i]);
  138.      end;
  139.     Dialog.SetTextToGrid;
  140.     Dialog.UpdateLineColStatus;
  141.     if Dialog.ShowModal = mrOK then
  142.     begin
  143.       Cls := TCheckListStrings.Create;
  144.       SetOrdValue( Longint( Dialog.EdtStrings.Lines ) );
  145.       Cls.Free;
  146.     end;
  147.   finally
  148.     Dialog.Free;
  149.   end;
  150. end;
  151.  
  152. type
  153.     TNewStrGrid = class(TStringGrid); { Needed to access InPlaceEditor }
  154.  
  155. { TChkStrLstDlg Methods }
  156.  
  157. procedure TChkStrLstDlg.SetTextToGrid;
  158. var
  159.    sText : string;
  160.    i     : integer;
  161. begin
  162.   grdEdit.RowCount := edtStrings.Lines.Count+2;
  163.   for i:=0 to edtStrings.Lines.Count-1 do
  164.    begin
  165.      sText := edtStrings.Lines[i];
  166.      grdEdit.Cells[0, i+1] := Copy(sText, 1, 1);
  167.      grdEdit.Cells[1, i+1] := Copy(sText, 3, Length(sText));
  168.    end;
  169.   grdEdit.Cells[0, grdEdit.RowCount-1] := '0';
  170.   ResizeGrid;
  171. end;
  172.  
  173. procedure TChkStrLstDlg.SetGridToText;
  174. var
  175.    i : Integer;
  176. begin
  177.   edtStrings.Clear;
  178.   for i:=1 to grdEdit.RowCount-2 do
  179.     edtStrings.Lines.Add(grdEdit.Cells[0, i]+'|'+grdEdit.Cells[1, i]);
  180. end;
  181.  
  182. procedure TChkStrLstDlg.ResizeGrid;
  183. begin
  184.   with grdEdit do
  185.    if VisibleRowCount<RowCount-1 then
  186.      ColWidths[1] := Width - ColWidths[0] - 6 - GetSystemMetrics(SM_CYHSCROLL)
  187.    else
  188.      ColWidths[1] := Width - ColWidths[0] - 6;
  189. end;
  190.  
  191. procedure TChkStrLstDlg.FormCreate(Sender: TObject);
  192. var
  193.   StyleBits  : Byte;
  194. begin
  195.   { Load settings from DELPHI.INI File }
  196.   DelphiIni := TIniFile.Create( 'DELPHI.INI' );
  197.   with grdEdit.Font do
  198.   begin
  199.     Name := DelphiIni.ReadString( Section, 'FontName', 'MS Sans Serif' );
  200.     Size := DelphiIni.ReadInteger( Section, 'FontSize', 8 );
  201.     Color := DelphiIni.ReadInteger( Section, 'FontColor', clBlack );
  202.     StyleBits := DelphiIni.ReadInteger( Section, 'FontStyle', fsNormal );
  203.     Style := [];
  204.     if StyleBits and fsBoldMask = fsBoldMask then
  205.       Style := Style + [ fsBold ];
  206.     if StyleBits and fsItalicMask = fsItalicMask then
  207.       Style := Style + [ fsItalic ];
  208.     if StyleBits and fsUnderlineMask = fsUnderlineMask then
  209.       Style := Style + [ fsUnderline ];
  210.     if StyleBits and fsStrikeOutMask = fsStrikeOutMask then
  211.       Style := Style + [ fsStrikeOut ];
  212.   end;
  213.   grdEdit.Cells[0,0] := 'State';
  214.   grdEdit.Cells[1,0] := 'Text';
  215. end;
  216.  
  217.  
  218. procedure TChkStrLstDlg.FormDestroy(Sender: TObject);
  219. begin
  220.   DelphiIni.Free;
  221. end;
  222.  
  223.  
  224. procedure TChkStrLstDlg.BtnOkClick(Sender: TObject);
  225. var
  226.   StyleBits : Byte;
  227. begin
  228.   if ChkDefault.Checked then
  229.   begin                                            { Save New Default Settings }
  230.     with grdEdit.Font do
  231.     begin
  232.       DelphiIni.WriteString( Section, 'FontName', Name );
  233.       DelphiIni.WriteInteger( Section, 'FontSize', Size );
  234.       DelphiIni.WriteInteger( Section, 'FontColor', Color );
  235.  
  236.       StyleBits := 0;
  237.       if fsBold in Style then
  238.         StyleBits := fsBoldMask;
  239.       if fsItalic in Style then
  240.         StyleBits := StyleBits + fsItalicMask;
  241.       if fsUnderline in Style then
  242.         StyleBits := StyleBits + fsUnderlineMask;
  243.       if fsStrikeOut in Style then
  244.         StyleBits := StyleBits + fsStrikeOutMask;
  245.       DelphiIni.WriteInteger( Section, 'FontStyle', StyleBits );
  246.     end;
  247.   end;
  248.   SetGridToText;
  249. end;
  250.  
  251. procedure TChkStrLstDlg.BtnFontClick(Sender: TObject);
  252. begin
  253.   DlgFont.Font := grdEdit.Font;
  254.   if DlgFont.Execute then
  255.   begin
  256.     grdEdit.Font := DlgFont.Font;           { Assign new font to Memo field }
  257.   end;
  258. end;
  259.  
  260. procedure TChkStrLstDlg.BtnUndoClick(Sender: TObject);
  261. begin
  262.   TNewStrGrid(grdEdit).InPlaceEditor.Perform( wm_Undo, 0, 0 );
  263. end;
  264.  
  265. procedure TChkStrLstDlg.BtnCutClick(Sender: TObject);
  266. begin
  267.   TNewStrGrid(grdEdit).InplaceEditor.CutToClipboard;
  268.   UpdateClipboardStatus;
  269. end;
  270.  
  271. procedure TChkStrLstDlg.BtnCopyClick(Sender: TObject);
  272. begin
  273.   TNewStrGrid(grdEdit).InplaceEditor.CopyToClipboard;
  274.   UpdateClipboardStatus;
  275. end;
  276.  
  277. procedure TChkStrLstDlg.BtnPasteClick(Sender: TObject);
  278. begin
  279.   TNewStrGrid(grdEdit).InplaceEditor.PasteFromClipboard;
  280. end;
  281.  
  282. procedure TChkStrLstDlg.UpdateLineColStatus;
  283. begin
  284.   LblLine.Caption := IntToStr( grdEdit.Row );
  285.   LblCount.Caption := IntToStr( grdEdit.RowCount-1) + ' Line(s)';
  286.   UpdateClipboardStatus;
  287. end;
  288.  
  289. procedure TChkStrLstDlg.UpdateClipboardStatus;
  290. var
  291.   HasText      : Boolean;
  292.   HasSelection : Boolean;
  293. begin
  294.   if TNewStrGrid(grdEdit).InplaceEditor<>nil then
  295.    HasSelection := TNewStrGrid(grdEdit).InPlaceEditor.SelLength <> 0
  296.   else
  297.    HasSelection := False;
  298.   BtnCut.Enabled := HasSelection;           { Cut and Copy are only enabled if }
  299.   MnuCut.Enabled := HasSelection;            { the user has selected some text }
  300.   BtnCopy.Enabled := HasSelection;
  301.   MnuCopy.Enabled := HasSelection;
  302.   HasText := Clipboard.HasFormat( cf_Text );
  303.   BtnPaste.Enabled := HasText;                  { Paste is only enabled if the }
  304.   MnuPaste.Enabled := HasText;                  { Clipboard contains Text      }
  305. end;
  306.  
  307.  
  308. procedure TChkStrLstDlg.EnableButtons( Enable : Boolean );
  309. var
  310.   SysMenu : HMenu;
  311. begin
  312.   BtnUndo.Enabled := Enable;
  313.   BtnFont.Enabled := Enable;
  314.   BtnOK.Enabled := Enable;
  315.   BtnCancel.Enabled := Enable;
  316.   ChkDefault.Enabled := Enable;
  317.  
  318.   EdtStrings.Enabled := Enable;
  319.  
  320.   BtnCut.Enabled := Enable;
  321.   BtnCopy.Enabled := Enable;
  322.   BtnPaste.Enabled := Enable;
  323.   if Enable then
  324.     UpdateClipboardStatus;
  325.  
  326.   { Disable the Close menu item, so dialog cannot be closed }
  327.   SysMenu := GetSystemMenu( Handle, False );
  328.   if Enable then
  329.     EnableMenuItem( SysMenu, sc_Close, mf_ByCommand or mf_Enabled )
  330.   else
  331.     EnableMenuItem( SysMenu, sc_Close, mf_ByCommand or mf_Disabled or mf_Grayed );
  332. end;
  333.  
  334. procedure TChkStrLstDlg.grdEditClick(Sender: TObject);
  335. begin
  336.   with grdEdit do
  337.    begin
  338.      if Col=1 then
  339.       begin
  340.         Options := Options + [goEditing];
  341.         EditorMode := True;
  342.       end
  343.      else
  344.       Options := Options - [goEditing];
  345.    end;
  346.   UpdateLineColStatus;
  347. end;
  348.  
  349. procedure TChkStrLstDlg.grdEditDrawCell(Sender: TObject; Col, Row: Longint;
  350.   Rect: TRect; State: TGridDrawState);
  351. var
  352.    FMinWidth : Integer;
  353.    RectCheck : TRect;
  354.    Halfy, i  : Integer;
  355. begin
  356.   if (Col=0) and (Row>0) then
  357.    begin
  358.      FMinWidth := 13;
  359.      CopyRect(RectCheck, Rect);
  360.      RectCheck.left := ((Rect.right-Rect.left) - FMinWidth) div 2;
  361.      RectCheck.top := Rect.top + ((Rect.bottom-Rect.top) - FMinWidth) div 2;
  362.      RectCheck.bottom := RectCheck.top + FMinWidth;
  363.      RectCheck.right := RectCheck.left + FMinWidth;
  364.      with grdEdit.Canvas, RectCheck do
  365.       begin
  366.         FillRect(Rect);
  367.         Pen.Color := clBtnShadow;
  368.         if grdEdit.Cells[Col, Row]='2' then
  369.          Brush.Color := clBtnFace
  370.         else
  371.           Brush.Color := clWindow;
  372.         Rectangle(left+1, top+1, right-1, bottom-1);
  373.         if (grdEdit.Cells[Col, Row]='1') or (grdEdit.Cells[Col, Row]='2') then
  374.          begin
  375.            InflateRect(RectCheck, -3, -3);
  376.            Pen.Color := clBlack;
  377.            Pen.Width := 1;
  378.            halfy := top+(bottom-top) div 2 + 1;
  379.            for i:=0 to 2 do
  380.             begin
  381.               PolyLine([Point(left,halfy-i), Point(left+2, halfy+2-i)]);
  382.               PolyLine([Point(left+2, halfy+2-i), Point(left+7, halfy-3-i)]);
  383.             end;
  384.          end
  385.       end
  386.    end;
  387. end;
  388.  
  389. procedure TChkStrLstDlg.grdEditDblClick(Sender: TObject);
  390. begin
  391.   if grdEdit.Col=0 then
  392.    case grdEdit.Cells[0, grdEdit.Row][1] of
  393.     '0' : grdEdit.Cells[0, grdEdit.Row] := '1';
  394.     '1' : grdEdit.Cells[0, grdEdit.Row] := '2';
  395.     '2' : grdEdit.Cells[0, grdEdit.Row] := '0';
  396.    end;
  397. end;
  398.  
  399. procedure TChkStrLstDlg.grdEditKeyPress(Sender: TObject; var Key: Char);
  400. begin
  401.   if grdEdit.Col=0 then
  402.    begin
  403.      Key := #0;
  404.      Exit;
  405.    end;
  406.   if grdEdit.Row=grdEdit.RowCount-1 then
  407.    begin
  408.      grdEdit.RowCount := grdEdit.RowCount+1;
  409.      grdEdit.Cells[0, grdEdit.RowCount-1] := '0';
  410.      UpdateLineColStatus;
  411.      ResizeGrid;
  412.    end;
  413. end;
  414.  
  415. procedure TChkStrLstDlg.grdEditMouseDown(Sender: TObject;
  416.   Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  417. begin
  418.   UpdateClipboardStatus;
  419. end;
  420.  
  421. procedure TChkStrLstDlg.grdEditMouseMove(Sender: TObject;
  422.   Shift: TShiftState; X, Y: Integer);
  423. begin
  424.   UpdateClipboardStatus;
  425. end;
  426.  
  427. procedure TChkStrLstDlg.cmdDeleteClick(Sender: TObject);
  428. var
  429.    i : integer;
  430. begin
  431.   if grdEdit.RowCount>2 then
  432.    begin
  433.      for i:=grdEdit.Row to grdEdit.RowCount-1 do
  434.       begin
  435.         grdEdit.Cells[0, i] := grdEdit.Cells[0, i+1];
  436.         grdEdit.Cells[1, i] := grdEdit.Cells[1, i+1];
  437.       end;
  438.      grdEdit.RowCount := grdEdit.RowCount-1;
  439.    end
  440.   else
  441.    i:=1;
  442.   grdEdit.Cells[0, grdEdit.RowCount-1] := '0';
  443.   grdEdit.Cells[1, grdEdit.RowCount-1] := '';
  444.   UpdateLineColStatus;
  445. end;
  446.  
  447. procedure TChkStrLstDlg.cmdDownClick(Sender: TObject);
  448. var
  449.    sTmp : array[1..2] of string;
  450.    iRow : integer;
  451. begin
  452.   iRow := grdEdit.Row;
  453.   if iRow<grdEdit.RowCount-1 then
  454.    begin
  455.      sTmp[1] := grdEdit.Cells[0, iRow];
  456.      sTmp[2] := grdEdit.Cells[1, iRow];
  457.      grdEdit.Cells[0, iRow] := grdEdit.Cells[0, iRow+1];
  458.      grdEdit.Cells[1, iRow] := grdEdit.Cells[1, iRow+1];
  459.      grdEdit.Cells[0, iRow+1] := sTmp[1];
  460.      grdEdit.Cells[1, iRow+1] := sTmp[2];
  461.      grdEdit.Row := iRow+1;
  462.      UpdateLineColStatus;
  463.    end;
  464. end;
  465.  
  466. procedure TChkStrLstDlg.cmdUpClick(Sender: TObject);
  467. var
  468.    sTmp : array[1..2] of string;
  469.    iRow : integer;
  470. begin
  471.   iRow := grdEdit.Row;
  472.   if iRow>1 then
  473.    begin
  474.      sTmp[1] := grdEdit.Cells[0, iRow];
  475.      sTmp[2] := grdEdit.Cells[1, iRow];
  476.      grdEdit.Cells[0, iRow] := grdEdit.Cells[0, iRow-1];
  477.      grdEdit.Cells[1, iRow] := grdEdit.Cells[1, iRow-1];
  478.      grdEdit.Cells[0, iRow-1] := sTmp[1];
  479.      grdEdit.Cells[1, iRow-1] := sTmp[2];
  480.      grdEdit.Row := iRow-1;
  481.      UpdateLineColStatus;
  482.    end;
  483. end;
  484.  
  485. procedure TChkStrLstDlg.grdEditKeyDown(Sender: TObject; var Key: Word;
  486.   Shift: TShiftState);
  487. begin
  488.   if grdEdit.Col=0 then Key:=0;
  489. end;
  490.  
  491. end.
  492.  
  493.